Shareware Grab Bag/Shareware Grab Bag.iso/007/tchasm.arc/TCHASM.PAS

Pascal/Delphi Source File | 1986-01-26 | 45KB | 1,847 lines

{$C-,I-,K-}
Program TChasm;

{**** Here are the hooks into the procedures for the Editor Toolbox ****}

{$I VARS.ED }    { Toolbox global variables and data structure definitions }

procedure UserCommand(var ch : byte);
{ user command processor hook }
begin
end;

procedure UserError(var Msgno : byte);
{ user error handler hook }
begin
end;

procedure userStatusline(Var TWindow:Byte;
                         Column,line:Integer;
                         Insertflag:Insflag;
                         WW,AI: boolean);
{ user status line handler }
begin
end;

procedure UserReplace(var ch : byte);
{ user replace handler hook }
begin
end;

procedure UserTask;
{ user multi-tasking hook }
begin
end;

{$I USER.ED      }  { Editor kernel and primitive level helper routines }
{$I SCREEN.ED    }  { Screen updating routines                          }

{$I INIT.ED      }  { initialization code      }
{$I KCMD.ED      }  { Ctrl-K routines          }
{$I QCMD.ED      }  { Ctrl-Q routines          }
{$I CMD.ED       }  { general editing commands }

{$I K.ED         }  { Ctrl-K dispatcher and interface             }
{$I Q.ED         }  { Ctrl-Q dispatcher and interface             }
{$I DISP.ED      }  { General command dispatcher                  }
{$I TASK.ED      }  { Scheduling subsystem and central dispatcher }
{$I INPUT.ED     }  { Input routines                              }

Function Exist(FileN: AnyString): boolean; {Checks to see if file exists }
var F: file;
begin
   {$I-}
   assign(F,FileN);
   reset(F);
   {$I+}
   if IOResult<>0 then Exist:=false
   else
   begin
     Exist:=true;
     close(F);
   end
end;

Procedure LowVideo;
   begin
     TextColor(BlockColor);
   end;
Procedure NormVideo;
   begin
     TextColor(TxtColor);
   end;

Procedure GetLine;  {Gets next line of Source from either memory or from
disk, depending on SourceLoc which may be the disk if there wasn't enough
memory for it in the editor.  I think this would be the place to install
the hooks for a macro processor }
var
  L : integer;

Begin {GetLine }

  Case SourceLoc of
    Disk : If NOT EOF(SourceFile) then
             Readln(SourceFile,InpLine)
           Else
             EndOfSource := true;

    Memory : With Curwin^ Do
               If CurLine <> NIL then
                 begin
                   L := CurLine^.BuffLen;                {Set Length of line }
                   Move(CurLine^.Txt^[1],InpLine[1],L);  {and trim its end }
                   While (L > 0) AND (InpLine[L] = ' ') Do L := Pred(L);
                   InpLine[0] := Chr(L);
                   CurLine := CurLine^.FwdLink;          {move forward for }
                 end                                     {next line }
               Else
                 EndOfSource := true;

  End; {Case SourceLoc }

  LineNum := Succ(LineNum); {set various assembler vars }
  NeedOffset := NONE;
  DSFlag := false;
  ObjLen := 0;

End;  {GetLine }

{***** NextWord returns tokens or words separated by delimiters that    *****
       separate them, such as commas or spaces, sent as [' ',','], etc.
       starting at StartPos.  Is included only for reading Tchasm.Dat }

Procedure NextWord(Line : AnyString; var Word : AnyString;
                   ParsePos : byte ; DelimSet : SetOfChar);
var
  StartPos : byte;

Begin {NextWord }

  {Skip any leading characters that aren't wanted }
  While (Line[ParsePos] in DelimSet) AND (ParsePos < Length(Line)) Do
    ParsePos := Succ(ParsePos);
  StartPos := ParsePos;

  While NOT (Line[ParsePos] in DelimSet) AND (ParsePos <= Length(Line)) DO
    ParsePos := Succ(ParsePos); {move one past token }

  Word := Copy(Line,StartPos,ParsePos-StartPos);
      ParsePos := Succ(ParsePos);

End;  {NextWord }

Procedure ErrorMessage(ErrMsg : AnyString); {Assembler error messages }

Begin
  If ListLoc <> NoIO then
    Writeln(ListFile,'** Error: ',ErrMsg,' **   ',LineNum);
  Errs := Succ(Errs);
End;

Procedure DiagMessage(DiagMsg : AnyString); {Assembler Diagnostics }

Begin
  If ListLoc <> NoIO then
    Writeln(ListFile,'** Diagnostic: ',DiagMsg,' **  ',LineNum);
  Diag := Succ(Diag);
End;

Function Hex(Num : integer) : AnyString; {same as ConvertBase, but takes
                                          number rather than string }
CONST
  R1 = 10; {base to convert from }
  R2 = 16; {base to convert to   }

var
  V,V2,T  : Real;
  C       : byte;
  TempHex : AnyString;

Begin {Hex }

  Str(Num,TempHex);
  T := 0;
  For C := 1 to Length(TempHex) Do
    begin
      V := Ord(TempHex[C]);
      If (V > 47) AND (V < 58) then V2 := V - 48;
      If (V > 64) AND (V < 91) then V2 := V - 55;
      If (V > 96) AND (V < 123) then V2 := V - 85;
      T := T * R1 + V2;
    end;

  TempHex := ''; {Don't need it anymore }
  While T <> 0 Do
    begin
      V2 := T - Trunc(T/R2)*R2;
      T := (T - V2)/R2;
      If V2 < 10 then V := V2 + 48;
      If V2 > 9  then V := V2 + 55;
      TempHex := Chr(Round(V)) + TempHex;
    end;

  If Length(TempHex) = 0 then TempHex := '0';
  Hex := TempHex;

End;  {Hex }

Function ConvertBase(Num : AnyString; FrBase,ToBase : NumTypes) : AnyString;
{Converts numbers from FrBase to ToBase }
var
  V,V2,T  : Real;
  C,R1,R2 : byte;      {R2 is base to convert to }

Begin {ConvertBase }

  Case FrBase of
    Hexadecimal : R1 := 16;
    BaseTen     : R1 := 10;
    Binary      : R1 := 2;
  End; {Case }

  Case ToBase of
    Hexadecimal : R2 := 16;
    BaseTen     : R2 := 10;
    Binary      : R2 := 2;
  End; {Case }

  T := 0;
  For C := 1 to Length(Num) Do
    begin
      V := Ord(Num[C]);
      If (V > 47) AND (V < 58) then V2 := V - 48;
      If (V > 64) AND (V < 91) then V2 := V - 55;
      If (V > 96) AND (V < 123) then V2 := V - 85;
      T := T * R1 + V2;
    end;

  Num := ''; {Don't need it anymore }
  While T <> 0 Do
    begin
      V2 := T - Trunc(T/R2)*R2;
      T := (T - V2)/R2;
      If V2 < 10 then V := V2 + 48;
      If V2 > 9  then V := V2 + 55;
      Num := Chr(Round(V)) + Num;
    end;

  If Length(Num) = 0 then Num := '0';
  ConvertBase := Num;

End;  {ConvertBase }

Function Caps(CapStr : AnyString) : AnyString; {Returns a string with
  all characters, except those within quotes, converted to uppercase }

var
  Quoted : boolean;
  i      : integer;

Begin {Caps }

  Quoted := false;

  for i := 1 to Length(CapStr) do
    begin
      if CapStr[i] = Quote then Quoted := NOT Quoted;
      if NOT Quoted then CapStr[i] := UpCase(CapStr[i]);
    end;
  Caps := CapStr;

End;  {Caps }

Procedure GetField; {Starting at LinePtr, trys to return next field in FldStr
                     sets Found if successful. (similar to NextWord) }
var
  QuotedString : boolean;

Begin {GetField }

  While (LinePtr <= EndPtr) AND (InpLine[LinePtr] in [' ',',']) Do
    LinePtr := Succ(LinePtr); {strip unwanted chars }

  If LinePtr > EndPtr then
    begin
      Found := false;
      EXIT;
    end;

  If InpLine[LinePtr] = Quote then  {Strings enclosed in quotes }
    begin
      Delete(InpLine,LinePtr,1);
      StrgEnd := Pos(Quote,InpLine);
      If StrgEnd <> 0 then StrgEnd := Succ(StrgEnd);
      Insert(Quote,InpLine,LinePtr);
      If StrgEnd > 0 then LinePtr2 := Succ(StrgEnd);
      QuotedString := true;
    end;

  If NOT QuotedString then
    begin
      LinePtr2 := LinePtr;
      While (LinePtr2 <= EndPtr) AND NOT (InpLine[LinePtr2] in [' ',',']) Do
        LinePtr2 := Succ(LinePtr2);
    end;

  FldStr := Copy(InpLine,LinePtr,LinePtr2 - LinePtr);

  LinePtr := LinePtr2;
  Found   := true;

End;  {GetField }

Procedure ParseLine; {Parses InpLine for Label, OpStr, SourceStr, DestStr }

Begin {ParseLine }

  LinePtr   := 1;
  LinePtr2  := 1;
  LabelStr  := '';
  OpStr     := '';
  SourceStr := '';
  DestStr   := '';

  EndPtr    := Pos(';',InpLine) - 1;     {Ignore comment after ";" }
  If EndPtr =  -1 then EndPtr := Length(InpLine);
  If EndPtr =  0 then EXIT; {No source code on line }

  InpLine := Caps(InpLine); {Convert to all CAPS, except quoted strings }

  {Label? }
  If InpLine[1] <> ' ' then
    begin
      GetField;
      LabelStr := Copy(FldStr,1,25);
      If LabelStr[Length(LabelStr)] = ':' then
        Delete(LabelStr,Length(LabelStr),1);
    end;

  {OpCode? }
  GetField;
  If NOT Found then EXIT;
  OpStr := FldStr;

  {Save Ptr to start of operands }
  OpdPtr := LinePtr;

  {Destination operand, if any }
  GetField;
  If NOT Found then EXIT;
  DestStr := FldStr;

  {Source operand, if any }
  GetField;
  If Found then SourceStr := FldStr;

End;  {ParseLine }

Procedure OperandLookup(OLSym : AnyString); {Look up OLSym in SymTable }

Begin {OperandLookup, really a Symbol Lookup, but...}

  TablePtr := 1;
  While (SymTable[TablePtr].Symbol <> OLSym) AND (TablePtr < NumSym) Do
    TablePtr := Succ(TablePtr);

  If SymTable[TablePtr].Symbol = OLSym then Found := true
  Else Found := false;

End;  {OperandLookup }

Procedure LookupOp; {Search for OpCode }

var
  Move  : Real;
  Start : integer;

Begin {LookupOp }

{Use binary search to speed up process }
  Move := NumOp;
  Start := Round(Move/2);

  While Move >= 2 Do
    begin
      Move := Move/2;
      If OpStr > OpCodes[Start].Mnemonic Then Start := Start + Round(Move)
      Else Start := Start - Round(Move);
      If Start < 1 then Start := 1;
      If Start > NumOp then Start := NumOp;
    end;

  OpPtr := Start;
  Found := false;
  While (OpPtr <= NumOp) AND NOT Found Do
    With OpCodes[OpPtr] Do
      begin
        If Mnemonic > OpStr then Found := true; {Not really, but... }
        If Mnemonic = OpStr then
          If SrcType AND SType <> 0 then
            If DstType AND DType <> 0 then Found := true;
        If NOT Found then OpPtr := Succ(OpPtr);
      end;

  If OpCodes[OpPtr].Mnemonic <> OpStr then Found := false;{Fix earlier mistake}

End;  {LookupOp }

Procedure NewEntry(NewSymbol : AnyString); {Add a symbol to SymTable }

Begin {NewEntry }

  {Already in table? }
  OperandLookup(NewSymbol);
  If Found then
    begin
      ErrorMessage('Dup definition of '+NewSymbol);
      EXIT;
    end;

  {Too many labels? }
  If NumSym >= MAXSYM then
    begin
      ErrorMessage('Too many user symbols');
      EXIT;
    end;

  {Make new entry }
  NumSym := Succ(NumSym);
  With SymTable[NumSym] Do
    begin
      Symbol  := NewSymbol;
      Val1    := Loctr;
      SymType := NEAR;
    end;

End;  {NewEntry }

Procedure TestNumber(TNStr : AnyString); {Trys to interpret TNStr as a
                               number; may be in base ten, hex, or binary }
var
  ValError : integer;

Begin {TestNumber }

  Found := false;

  {Hex? }
  If TnStr[Length(TnStr)] = 'H' then
    begin
      Delete(TnStr,Length(TnStr),1);
      Val('$'+TnStr,NumVal,ValError);
    end
  Else
  {Binary?}
  If TnStr[Length(TnStr)] = 'B' then
    begin
      Delete(TnStr,Length(TnStr),1);
      TnStr := ConvertBase(TnStr,Binary,BaseTen);
      Val(TnStr,NumVal,ValError);
    end
  Else
  {Decimal?}
    Val(TnStr,NumVal,ValError);

  If ValError = 0 then
        begin
          Found := true;
          If Length(Hex(NumVal)) < 3 then NumType := IMMED16 OR IMMED8
          Else NumType := IMMED16;
        end

End;  {TestNumber }

Procedure MemRef(DataType : integer); {Builds memory address word }

Begin {MemRef }

  If DataType = MEMY then DataType := DVal1 Else DataType := Sval1;

  ObjLen := ObjLen + 2;
  Obj[ObjLen-1] := Lo(DataType);
  Obj[ObjLen]   := Hi(DataType);

End;  {MemRef }

Procedure MemoryRef(MemStr : AnyString); {Trys to interpret MemStr as direct
                                          memory reference }
var
  MR : AnyString;

Begin {MemoryRef }

  If (MemStr[1] = '[') AND (MemStr[Length(MemStr)] = ']') then
    begin
      MemStr := Copy(MemStr,2,Length(MemStr) - 2);
      TestNumber(MemStr);
      If Found then
        MemAddr := NumVal
      Else
        begin
          OperandLookup(MemStr);
          If Found then
            If (SymTable[TablePtr].SymType AND IMMED16) <> 0 then
              MemAddr := SymTable[TablePtr].Val1
            Else
              Found := false;
        end
    end

End;  {MemoryRef }

Procedure ProcOffset(OS : AnyString); {interpret OS as an offset operand }

Begin {ProcOffset }

  Found := true;

  If Copy(OS,1,7) <> 'OFFSET(' then
    Found := False
  Else
    begin
      If Pass = 1 then
        OffsetType := IMMED16
      Else
        begin
          OS := Copy(OS,8,Length(OS) - 8);
          OperandLookup(OS);
          If Found AND (SymTable[TablePtr].SymType AND (MEMY OR NEAR) <> 0) then
            begin
              OffsetVal := SymTable[TablePtr].Val1;
              OffsetType := IMMED16;
            end
          Else
            begin
              ErrorMessage('Illegal or Undefined arg. for Offset');
              OffsetVal := 0;
              Found := true;
              OffsetType := IMMED16;
            end
        end
    end

End;  {ProcOffset }

Procedure ParseDispOffReg(PDOR : AnyString); {interpret PDOR as offset off
                                              of a register }
var
  RegStr : AnyString;
  Pointer : integer;

  Procedure ParseDisp(DispStr : AnyString);
    Begin {internal ParseDisp }
      DispStr := Copy(DispStr,1,Pointer - 1);
      OperandLookup(DispStr);
      If Found AND
         (SymTable[TablePtr].SymType AND (IMMED16 OR IMMED8) <> 0) then
            begin
              NeedOffset := SymTable[TablePtr].SymType;
              Offset     := SymTable[TablePtr].Val1;
              EXIT;
            end;

      TestNumber(DispStr);
      If Found then
        begin
          NeedOffset := NumType;
          Offset := NumVal;
          EXIT;
        end;

      ProcOffset(DispStr);
      If Found then
        begin
          NeedOffset := OffsetType;
          Offset := OffsetVal;
        end

  end; {internal ParseDisp }

Begin {ParseDispOffReg }

  If PDOR = '[BP]' then
    begin
      RegVal := 6;
      NeedOffset := IMMED8;
      Offset := 0;
      Found := true;
    end
  Else
    begin
      Pointer := Pos('[',PDOR);
      If Pointer <= 1 then
        begin
          Found := false;
          EXIT;
        end;
      RegStr := Copy(PDOR,Pointer,Length(PDOR) - Pointer + 1);
      If RegStr <> '[BP]' then
        begin
          OperandLookup(RegStr);
          If NOT Found OR (SymTable[TablePtr].SymType <> MemReg) then
            begin
              Found := false;
              EXIT;
            end
          Else
            begin
              RegVal := SymTable[TablePtr].Val1;
              ParseDisp(RegStr);
            end
        end
      Else
        begin
          RegVal := 6;
          ParseDisp(RegStr);
        end
    end

End;  {ParseDispOffReg }

Procedure Charactor(ch : AnyString); {checks to see if ch is quoted char }

Begin {Charactor }

  Found := false;
  If Length(ch) = 3 then
    If ch[1] = Quote then
      If ch[Length(ch)] = Quote then
        begin
          Found := true;
          CharVal := Ord(ch[2]);
        end;

End;  {Charactor }

Procedure TypeOperand(OperStr : AnyString); {checks type of operand }

Begin {TypeOperand }

  {Any operand? }
  If Length(OperStr) = 0 then
    begin
      TargType := NONE;
      EXIT;
    end;

  {In Symbol Table? }
  OperandLookup(OperStr);
  If Found then
    begin
      TargType := SymTable[TablePtr].SymType;
      TargVal1 := SymTable[TablePtr].Val1;
      If TablePtr <= Predef then TargVal2 := SymTable[TablePtr].Val2;
      EXIT;
    end;

  {Number? }
  TestNumber(OperStr);
  If Found then
    begin
      TargType := NumType;
      TargVal1 := NumVal;
      EXIT;
    end;

  {Direct memory reference? }
  MemoryRef(OperStr);
  If Found then
    begin
      TargType := MEMY;
      TargVal1 := MemAddr;
      EXIT;
    end;

  {Offset off register? }
  ParseDispOffReg(OperStr);
  If Found then
    begin
      TargType := MEMREG;
      TargVal1 := RegVal;
      EXIT;
    end;

  {Offset? }
  ProcOffset(OperStr);
  If Found then
    begin
      TargType := OffSetType;
      TargVal1 := OffsetVal;
      EXIT;
    end;

  {Character? }
  Charactor(OperStr);
  If Found then
    begin
      TargType := IMMED8 OR IMMED16;
      TargVal1 := CharVal;
      EXIT;
    end;

  {String? }
  If OperStr[1] = Quote then
    begin
      TargType := STRG;
      EXIT;
    end;

  {Not found? Assume Near Label or Memory Reference, (error on Pass 2) }
  If Pass = 2 then ErrorMessage('Undefined Symbol '+ OperStr);

  TargType := NEAR OR MEMY;

End;  {TypeOperand }

Procedure OpType; {Decides between word and byte operands }

Begin {OpType }

  If ((DType OR SType) AND (REG16 OR ACUM16 OR SEGMNT OR C_S) <> 0) then
    Word := true
  Else
    If ((DType OR SType) AND (REG8 OR ACUM8) <> 0) then
      Word := false
    Else
      If OpStr[Length(OpStr)] = 'B' then
        Word := false
      Else
        Word := true;

End;  {OpType }

Procedure BuildOpCode; {builds the op code }

Begin {BuildOpCode }

  ObjLen := Succ(ObjLen);
  Obj[ObjLen] := OpCodes[OpPtr].OpCodeVal;

  If (Flag AND ADDREG) <> 0 then
    If (DType AND (SEGMNT OR C_S)) <> 0 then
      Obj[ObjLen] := Obj[ObjLen] + DVal2
    Else
      If (Flag AND DIRECTION) <> 0 then
        Obj[ObjLen] := Obj[ObjLen] + SVal2 DIV 8
      Else
        Obj[ObjLen] := Obj[ObjLen] + Dval2 DIV 8;

  If ((Flag AND AUTOW) <> 0) AND Word then Obj[ObjLen] := Succ(Obj[ObjLen]);

  If ((Flag AND AUTOC) <> 0) AND (SType AND CL <> 0) then
    Obj[ObjLen] := Obj[ObjLen] + 2;

End;  {BuildOpCode }

Procedure BuildModeByte; {builds addressing mode byte, and if necessary
                          the displacement byte(s) }
var
  M : integer;

Begin {BuildModeByte }

  ObjLen := Succ(ObjLen);

  If ((DType OR SType) AND MEMY) <> 0 then
    begin
      If DType = MEMY then M := SVal2 else M := DVal2;
      Obj[ObjLen] := 6 + M;
      MemRef(DType);
      EXIT;
    end;

  If (Flag AND DIRECTION) <> 0 then M := SVal1 + DVal2 Else M := DVal1 + SVal2;
  Obj[ObjLen] := M;

  If NeedOffset <> NONE then
    begin
      If (Offset <= 127) AND (Offset >= -128) then
        begin
          Obj[ObjLen] := Obj[ObjLen] + 64;
          If Offset < 0 then Offset := Offset AND $FF;
          ObjLen := Succ(ObjLen);
          Obj[ObjLen] := Offset;
        end
      Else
        begin
          Obj[ObjLen] := Obj[ObjLen] + 128;
          ObjLen := ObjLen + 2;
          Obj[ObjLen-1] := Lo(Offset);
          Obj[ObjLen]   := Hi(Offset);
        end;
    end;

End;  {BuildModeByte }

Procedure BuildExtensionByte; {builds the opcode extension from bits 3-5 of
                               the flag word }
Var
  Ext,Mask : integer;

Begin {BuildExtensionByte }

  Mask := $38;
  Ext := Flag AND Mask;

  If (Flag AND DIRECTION) <> 0 then DVal2 := Ext Else SVal2 := Ext;

  BuildModeByte;

End;  {BuildExtensionByte }

Procedure BuildDisp8; {calcs displacement from present location to
                       location given as operand }
var
  D : integer;

Begin {BuildDisp8 }

  D := DVal1 - Loctr;
  If ABS(D) >= 128 then
    begin
      D := 0;
      If Pass = 2 then ErrorMessage('Too far for short jump');
    end;

  If D < 0 then D := D AND $FF;

  ObjLen := Succ(ObjLen);
  Obj[ObjLen] := D;

End;  {BuildDisp8 }

Procedure BuildDisp16; {calcs disp from loc to loc }

var
  D : integer;

Begin {BuildDisp16 }

  D := DVal1 - Loctr;
  If (OpStr = 'JMP') AND (D <= 128) then DiagMessage('Could use JMPS');

  If (D < 0) AND (OpStr <> 'CALL') then
    begin
      D := 0;
      If Pass = 2 then ErrorMessage('Illegal reverse long jump');
    end;

  ObjLen := ObjLen + 2;
  Obj[ObjLen-1] := Lo(D);
  Obj[ObjLen]   := Hi(D);

End;  {BuildDisp16 }

Procedure BuildImmed8; {builds byte of immediate data }

var
  IVal : integer;

  Procedure SubImmed8;
  Begin {internal SubImmed8 }

    If NOT (IVal in [0..255]) then
      begin
        IVal := 0;
        If Pass = 2 then ErrorMessage('Data too long');
      end;
      ObjLen := Succ(ObjLen);
      Obj[ObjLen] := IVal;

  End;  {internal SubImmed8 }

Begin {BuildImmed8 }

  If (DType AND IMMED8) <> 0 then
    begin
      IVal := DVal1;
      SubImmed8;
    end;

  If (SType AND IMMED8) <> 0 then
    begin
      IVal := SVal1;
      SubImmed8;
    end;

End;  {BuildImmed8 }

Procedure BuildImmed16; {builds immediate word(s) }

Begin {BuildImmed16 }

  If (DType AND IMMED16) <> 0 then
    begin
      ObjLen := ObjLen + 2;
      Obj[ObjLen-1] := Lo(DVal1);
      Obj[ObjLen]   := Hi(DVal1);
    end;

  If (SType AND IMMED16) <> 0 then
    begin
      ObjLen := ObjLen + 2;
      Obj[ObjLen-1] := Lo(SVal1);
      Obj[ObjLen]   := Hi(SVal1);
    end;

End;  {BuildImmed16 }

Procedure ProcMachOp; {updates Loctr based on op length, and makes obj code }

Begin {ProcMachOp }

  OpType;
  Loctr := Succ(Loctr);

  If Pass = 2 then BuildOpCode;
  If (OpCodes[OpPtr].OpCodeVal = $D5) OR (OpCodes[OpPtr].OpCodeVal = $D4) then
    begin
      Loctr := Succ(Loctr);
      If Pass = 2 then
        begin
          ObjLen := Succ(ObjLen);
          Obj[ObjLen] := $A;
        end;
    end;

  If NeedOffset <> NONE then
    If (NeedOffset AND IMMED8 <> 0) then Loctr := Succ(Loctr)
    Else Loctr := Loctr + 2;

  If (Flag AND (NEEDMODEBYTE OR NEEDEXT)) <> 0 then
    If ((DType OR SType) AND MEMY) <> 0 then Loctr := Loctr + 2;

  If (Flag AND NEEDEXT) <> 0 then
    begin
      Loctr := Succ(Loctr);
      If Pass = 2 then BuildExtensionByte;
    end;

  If (Flag AND NEEDMODEBYTE) <> 0 then
    begin
      Loctr := Succ(Loctr);
      If Pass = 2 then BuildModeByte;
    end;

  If (Flag AND NEEDISP8) <> 0 then
    begin
      Loctr := Succ(Loctr);
      If Pass = 2 then BuildDisp8;
    end;

  If (Flag AND NEEDISP16) <> 0 then
    begin
      Loctr := Loctr + 2;
      If Pass = 2 then BuildDisp16;
    end;

  If (Flag AND NEEDIMMED8) <> 0 then
    begin
      Loctr := Succ(Loctr);
      If Pass = 2 then BuildImmed8;
    end;

  If NOT Word AND ((Flag AND NEEDIMMED) <> 0) then
    begin
      Loctr := Succ(Loctr);
      If Pass = 2 then BuildImmed8;
    end;

  If Word AND ((Flag AND NEEDIMMED) <> 0) then
    begin
      If DType = IMMED16 then Loctr := Loctr + 4 Else Loctr := Loctr + 2;
      If Pass = 2 then BuildImmed16;
    end;

  If (Flag AND NEEDMEM) <> 0 then
    begin
      Loctr := Loctr + 2;
      If Pass = 2 then MemRef(DType);
    end;

End;  {ProcMachOp }

Procedure ProcEQU; {EQU pseudo op }

Begin {ProcEQU }

  If LabelStr = '' then
    begin
      If Pass = 2 then ErrorMessage('EQU without symbol');
    end
  Else
    If Pass <> 2 then
      begin
        If DType = (NEAR OR MEMY) then
          ErrorMessage('EQU with forward reference')
        Else
          begin
            SymTable[NumSym].Val1 := DVal1;
            SymTable[NumSym].SymType := DType;
          end;
      end;

End;  {ProcEQU }

Procedure ProcORG; {ORG pseudo op }

Begin {ProcORG }

  Loctr := DVal1;

End;  {ProcORG }

Procedure ProcDB; {DB pseudo op }

  Procedure BuildByte;

  Begin {internal BuildByte }

    ObjLen := Succ(ObjLen);
    Obj[ObjLen] := NumVal;

  End;  {internal BuildByte }

  Procedure BuildStg;

  Begin {internal BuildStg }

    FldStr := Copy(FldStr,2,Length(FldStr)-2);
    For i := 1 to Length(FldStr) Do
      begin
        ObjLen := Succ(ObjLen);
        Obj[ObjLen] := ord(FldStr[i]);
      end;

  End;  {internal BuildStg }

Begin {ProcDB }

  If LabelStr <> '' then SymTable[NumSym].SymType := MEMY;

  LinePtr  := OpdPtr;
  LinePtr2 := OpdPtr;

  While LinePtr < EndPtr Do
    begin
      GetField;
      If NOT Found then
        begin
          Loctr := Loctr + ObjLen;
          EXIT;
        end;

      TargetStr := FldStr;
      TestNumber(TargetStr);
      If Found AND (NumType AND IMMED8 <> 0) then
        BuildByte
      Else
        If FldStr[1] = Quote then
          BuildStg
        Else
          If Pass = 2 then ErrorMessage('Unrecognized operand '+FldStr);
    end; {While..Do }

  Loctr := Loctr + ObjLen;

End;  {ProcDB }

Procedure ProcDS; {DS pseudo op }

var
  DSVal : integer;

Begin {ProcDS }

  DSFlag := true;
  If LabelStr <> '' then SymTable[NumSym].SymType := MEMY;
  If (SType AND IMMED8) <> 0 then DSVal := SVal1 Else DSVal := 0;
  If Pass <> 1 then For i := 1 to DVal1 do Write(ObjFile,chr(DSVal));

  Loctr := Loctr + DVal1;

End;  {ProcDS }

Procedure ProcPROC; {PROC pseudo op }

Begin {ProcPROC }

  If StkTop < MAXSTK then
    begin
      StkTop := Succ(StkTop);
      ProcType[StkTop] := DType;
    end
  Else
    If Pass <> 1 then ErrorMessage('Procedures nested too deeply');

End;  {ProcPROC }

Procedure ProcENDP; {ENDP pseudo op }

Begin {ProcENDP }

  If StkTop > 0 then StkTop := Pred(StkTop)
  Else If Pass <> 1 then ErrorMessage('ENDP without PROC');

End;  {ProcENDP }

Procedure PseudoOp;

Begin {PseudoOp }

  Case OpCodes[OpPtr].OpCodeVal of
    1 : ProcEQU;
    2 : ProcORG;
    3 : ProcDB;
    4 : ProcDS;
    5 : ProcPROC;
    6 : ProcENDP;
  End;

End;  {PseudoOp }

Procedure UpdateLoctr; {decodes operation and advances Loctr }

Begin {UpdateLoctr }

  TypeOperand(DestStr);
  DType := TargType;
  DVal1 := TargVal1;
  DVal2 := TargVal2;

  If OpStr = 'RET' then
    SType := ProcType[StkTop]
  Else
    begin
      TypeOperand(SourceStr);
      SType := TargType;
      SVal1 := TargVal1;
      SVal2 := TargVal2;
    end;

  TargetStr := OpStr;
  LookupOp;
  If Found then
    begin
      Flag := OpCodes[OpPtr].Flagss;
      If (Flag AND MACHOP) <> 0 then
        ProcMachOp
      Else
        PseudoOp;
    end
  Else
    If Pass <> 1 then
      begin
        ErrorMessage('Syntax Error: '+OpStr);
        If ((ACUM8 OR ACUM16 OR REG8 OR REG16 OR SEGMNT OR C_S) AND
           (DType OR SType)) = 0 Then
          If (SType AND (NONE OR IMMED8 OR IMMED16)) <> 0 Then
            If NOT (OpStr[Length(OpStr)] in ['B','W']) then
              DiagMessage('Specify Word or Byte Operation');
      end;

End;  {UpdateLoctr }

Procedure Progress; {Gives user status of assemble }

var
  X,Y : integer;

Begin {Progress }

  If LineNum MOD 6 = 0 then {Only update every fourth line, saves time.. }
    begin
      LowVideo;
      X := WhereX;
      Y := WhereY;
      GoToXY(60,1);
      If Pass = 1 then Write('Pass: 1  Line: ',LineNum)
      Else Write('Pass: 2  Line: ',LineNum);
      ClrEol;
      GoToXY(X,Y);
      NormVideo;
    end;

End;  {Progress }

Procedure CheckPhase; {label value same on both passes? }

Begin {CheckPhase }

  If OpStr <> 'EQU' then
    begin
      TargetStr := LabelStr;
      OperandLookup(TargetStr);

      With SymTable[TablePtr] Do
        If ((SymType AND (NEAR OR MEMY)) <> 0) AND (Val1 <> Loctr) Then
          ErrorMessage('Phase Error');
    end;

End;  {CheckPhase }

Procedure WrOutput; {Write the object code and then listing }

var
  H : AnyString;
  Spacing : byte;

Begin {WrOutput }

  For i := 1 to ObjLen Do Write(ObjFile,Chr(Obj[i]));
  CodeSize := CodeSize + ObjLen;

  If ListLoc <> NoIO then
    begin
      If DSFlag then H := Hex(Loctr-DVal1) Else H := Hex(Loctr-ObjLen);

     {Pad hex number }
      Case Length(H) of
        0 : H := '0000';
        1 : H := '000' + H;
        2 : H := '00' + H;
        3 : H := '0' + H;
      End; {Case }
      Write(ListFile,H,' ');

      Spacing := 0;
      For i := 1 to ObjLen Do
        begin
          H := Hex(Obj[i]);
          If Length(H) = 1 then H := '0' + H;
          Write(ListFile,H);
          Spacing := Spacing + Length(H);
        end;

      Writeln(ListFile,'':16-Spacing,LineNum:4,' ',InpLine);
    end;

End;  {WrOutput }

Procedure FirstPass;  {Adds user-defined symbols to symbol table }

Begin {FirstPass }

  Pass := 1;
  Loctr := 256;
  LineNum := 0;
  EndofSource := false;

  If SourceLoc = Memory then
    begin {reset CurLine to point to first line in text stream }
      With Curwin^ Do
        begin
          CurLine := TopLine;
          While CurLine^.BackLink <> NIL Do
            CurLine := CurLine^.BackLink;
        end
    end
  Else
    begin
      Assign(SourceFile,SourceName);
      Reset(SourceFile);
    end;

  While NOT EndOfSource Do
    begin
      GetLine;
      ParseLine;
      If LabelStr <> '' then NewEntry(LabelStr);
      If OpStr    <> '' then UpdateLoctr;
      Progress;
    end;

  If SourceLoc = Disk then Close(SourceFile);

End;  {FirstPass }

Procedure PassTwo; {Generates object code }

Begin {PassTwo }

  Pass := 2;
  Loctr := 256;
  LineNum := 0;
  EndofSource := false;

  If SourceLoc = Memory then
    begin {reset CurLine to point to first line in text stream }
      With Curwin^ Do
        begin
          CurLine := TopLine;
          While CurLine^.BackLink <> NIL Do
            CurLine := CurLine^.BackLink;
        end
    end
  Else
    begin
      Assign(SourceFile,SourceName);
      Reset(SourceFile);
    end;

  While NOT EndOfSource Do
    begin
      GetLine;
      If NOT EndOfSource then
        begin
          ParseLine;
          If LabelStr <> '' then CheckPhase;
          If OpStr    <> '' then UpdateLoctr;
          WrOutput;
          Progress;
        end;
    end;

  If SourceLoc = Disk then Close(SourceFile);

End;  {PassTwo }

Procedure DumpSymTable; {show the symbol table }

Begin {DumpSymTable }

  If ListLoc <> NoIO then
    begin
      Writeln(ListFile);
      Writeln('Symbol Table Dump');
      i := Predef + 1;

      While i <= NumSym Do
        With SymTable[i] Do
          begin
            Writeln(ListFile,Symbol:20,Hex(Val1):8);
            i := Succ(i);
          end;
    end;

End;  {DumpSymTable }

Procedure FinalProc; {we must always finish what we started }

Begin {FinalProc }

  If StkTop > 0 then ErrorMessage('missing ENDP');

  Writeln(ListFile);
  Writeln(ListFile,Pred(LineNum),' Lines Assembled');
  Writeln(ListFile,'CodeSize: ',CodeSize,' Bytes');
  Writeln(ListFile,Errs,' Error(s) detected');
  Writeln(ListFile,Diag,' Diagnostic(s) offered');

  DumpSymTable;

  Close(ObjFile);
  If SourceLoc = Disk then Close(SourceFile);
  If ListLoc = Disk then Close(ListFile);

End;  {FinalProc }

Procedure SetUpTables;  {Reads the file TChasm.Dat into the OpCode and
                         Symbol tables. }

Var
  i : integer;

Begin {SetUpTables }

  Repeat
    If NOT Exist(OPCODEFILE) then
      begin
        Writeln('"',OPCODEFILE,'" is not on this disk.');
        Writeln('[I]nsert new disk or [Q]uit? ');
        Repeat Read(Kbd,ch) Until UpCase(ch) in ['I','Q'];
        If UpCase(ch) = 'Q' then HALT;
      end;
  Until Exist(OPCODEFILE);

  Assign(DataFile,OPCODEFILE);
  Reset(DataFile);

  Readln(DataFile,NumOp);  {Read NumOp from file to see if too large }
  if NumOp > MAXNUMOP then
    begin
      Writeln('Number of defined OpCodes is too large');
      HALT;
    end;

  Readln(DataFile,InpLine); {Read Quote character and skip comments in file }
  Quote := InpLine[1]; {get quote character }

  For i := 1 to NumOp do
    With OpCodes[i] Do
      begin
        Readln(DataFile,OpCodeVal,DstType,
               SrcType,Flagss,InpLine);
        {$V-}
        NextWord(InpLine,Mnemonic,1,[' ',',']);
        {$V+}
      end;

  Readln(DataFile,Predef);  {Read Predef from file to see if it matches }
  if Predef > MAXSYM then
    begin
      Writeln('Number of defined Symbols is too large');
      HALT;
    end;

  Readln(DataFile,InpLine); {skip comments in file }

  For i := 1 to Predef do
    With SymTable[i] Do
      begin
        Readln(DataFile,Val1,Val2,SymType,InpLine);
        {$V-}
        NextWord(InpLine,Symbol,1,[' ',',']);
        {$V+}
      end;

  NumSym := Predef;
  Close(DataFile);

End;  {SetUpTables }

Procedure TitleStart;

Begin {TitleStart }

{Print Title }
  NormVideo;
  ClrScr;
  GoToXY(18,25);
  Writeln('┌────────────────────────────────────────────┐');GoToXY(18,25);
  Writeln('│                                            │');GoToXY(18,25);
  Writeln('│          "Turbo" Cheap Assembler  1.0      │');GoToXY(18,25);
  Writeln('│           by Mark Streich                  │');GoToXY(18,25);
  Writeln('│           based upon CHASM (tm)            │');GoToXY(18,25);
  Writeln('│           by Dave Whitman                  │');GoToXY(18,25);
  Writeln('│                                            │');GoToXY(18,25);
  Writeln('│                                            │');GoToXY(18,25);
  Writeln('└────────────────────────────────────────────┘');

  Write(#10#10#10#10#10#10#10#10#10#10);

End;  {TitleStart }

{********************** Main Screen Procedures *****************************}

Procedure ShowDirectory; {from Turbo Tutor (tm) - GREAT book and disk,
                          This is just one of many programs included }
type
  Char12arr            = array [ 1..12 ] of Char;
  String20             = string[ 20 ];
  RegRec =
    record
      AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer;
    end;

var
  Regs                 : RegRec;
  DTA                  : array [ 1..43 ] of Byte;
  Mask                 : Char12arr;
  NamR                 : AnyString;
  Drive,
  Error, I             : Integer;

begin {ShowDirectory }

  FillChar(DTA,SizeOf(DTA),0);        { Initialize the DTA buffer }
  FillChar(Mask,SizeOf(Mask),0);      { Initialize the mask }
  FillChar(NamR,SizeOf(NamR),0);      { Initialize the file name }

  Write( 'Directory Mask? ' );
  Readln(NamR);
  NamR := Caps(NamR);
  If NamR = '' then NamR := LogDir + '*.*'
  Else
  if (Length(NamR) = 2) AND (Pos(':',NamR) = 2) then NamR := NamR + '\*.*'
  Else
  if Length(NamR) = 1 then NamR := NamR + ':\*.*'
  Else
  if Pos(':',NamR) = 0 then NamR := LogDir + NamR;

  Drive := Ord(NamR[1])-64;

  Writeln('Directory of ',NamR);
  For I := 1 to Length(NamR) Do Mask[I] := NamR[I];
  Regs.AX := $1A00;         { Function used to set the DTA }
  Regs.DS := Seg(DTA);      { store the parameter segment in DS }
  Regs.DX := Ofs(DTA);      {   "    "      "     offset in DX }
  MSDos(Regs);              { Set DTA location }
  Error := 0;
  Regs.AX := $4E00;          { Get first directory entry }
  Regs.DS := Seg(Mask);      { Point to the file Mask }
  Regs.DX := Ofs(Mask);
  Regs.CX := 1;             { Store the option }
  MSDos(Regs);               { Execute MSDos call }
  Error := Regs.AX and $FF;  { Get Error return }
  I := 1;                    { initialize 'I' to the first element }
  if (Error = 0) then
    repeat
      NamR[I] := Chr(Mem[Seg(DTA):Ofs(DTA)+29+I]);
      I := I + 1;
    until not (NamR[I-1] in [' '..'~']) or (I>20);

  NamR[0] := Chr(I-1);          { set string length because assigning }
                                { by element does not set length }
  while (Error = 0) do begin
    Error := 0;
    Regs.AX := $4F00;           { Function used to get the next }
                                { directory entry }
    Regs.CX := 22;              { Set the file option }
    MSDos( Regs );              { Call MSDos }
    Error := Regs.AX and $FF;   { get the Error return }
    I := 1;
    repeat
      NamR[I] := Chr(Mem[Seg(DTA):Ofs(DTA)+29+I]);
      I := I + 1;
    until not (NamR[I-1] in [' '..'~'] ) or (I > 20);
    NamR[0] := Chr(I-1);
    if (Error = 0)
      then Write(NamR,'':16-Length(NamR));
  end;
  Writeln;

  If Drive in [1..26] then
    begin
      Regs.AX := $3600;               { Get Disk free space }
      Regs.DX := Drive;               { Store Drive number }
      MSDos( Regs );                  { Call MSDos to get disk info }
      Writeln(((Regs.AX*Regs.CX*1.0)*Regs.BX):1:0,' Bytes Free');
    end;

  Write('>');

End;  {ShowDirectory }

Procedure Say(S: AnyString); {Will write to the screen a string passed
   as a parameter.  Special control sequences can be embedded into the
   string to set the Normal Video (%!) and Low Video and do a Carriage
   Return (%@). For example, '%!Hello' will highlight the letter H and
   write the rest of the word in normal video }

    Var
      I: Integer;

    Begin
      I:=1;
      While I<=Length(S) Do
       Begin
        If Ord(S[I])<32 Then Write('^',Chr(Ord(S[I])+64))
        Else If S[I]<>'%' Then Write(S[I])
             Else If S[I+1]='@' Then          {%@ = Carriage Return         }
               Begin
                 WriteLn;
                 LowVideo;
                 I:=I+1;
               End
             Else If S[I+1]='!' Then          {%! = HighVideo for next char }
                    Begin
                      NormVideo;
                      Write(S[I+2]);
                      LowVideo;
                      I:=I+2;
                    End
             Else If S[I+1]='#' Then          {%# = Set HighVideo until unset}
                    Begin
                      NormVideo;
                      I := I+1;
                    End
                  Else Write('%');
                  I:=I+1;
      End; { While I<=Length(S) }

      NormVideo;
    End; { Say }

Procedure MainScreen; {Handles the Main Control Screen }

Begin {MainScreen }

  ClrScr;
  LowVideo;
  Say('Turbo Cheap Assembler%@%@');
  GetDir(0,LogDir); { Get the current directory of the current drive. }
  Say('%!Logged Directory: %#'+LogDir+'%@%@');
  Say('%!Work File: %#'+SourceName+'%@');

  Case SourceLoc of
    Disk   : Say('%@File Location: Disk%@');
    Memory : Say('%@File Location: Memory%@');
  End; {Case SourceLoc }

  Case ListLoc of
    Scrn    : Say('%!Output Location: %#Screen%@%@');
    Printer : Say('%!Output Location: %#Printer%@%@');
    NoIO    : Say('%!Output Location: %#None%@%@');
    Else      Say('%!Output Location: %#'+ListName+'%@%@');
  End; {Case ListType }

  Say('%!Edit        %!Save%@');
  Say('%!Directory   %!Assemble   %!Quit%@%@%!>');

End;  {MainScreen }

Procedure ChangeDirectory;

Var
  TempDir : AnyString;

Begin {ChangeDirectory }
  TempDir := LogDir;
  Repeat
    Write('New Directory? ');
    Readln(LogDir);
    LogDir := Caps(LogDir);
    if LogDir = '' then LogDir := TempDir
    Else
    if (LogDir='A') OR (LogDir='B') OR (LogDir='C') then
      LogDir := LogDir + ':';
    {$I-}
    ChDir(LogDir);
    {$I+}
  Until IOresult = 0;

  Writeln;
  Write('>');

End;  {ChangeDirectory }

Procedure ChangeWorkFile;

Var
  TempWorkFile : AnyString;

Begin {ChangeWorkFile }

  If SourceLoc = Memory then
    begin
      if EditChangeFlag then
        begin
          Write('Save changes? [Y/N] ');
          Repeat Read(Kbd,ch) Until UpCase(ch) in ['Y','N'];
          Writeln(UpCase(ch));
          If UpCase(ch) = 'Y' then if EditFileWrite(SourceName) then;
          EditChangeFlag := false; {reset for new file }
        end;
      EditWindowDeleteText;
    end;

  OK := true;
  SourceLoc := Disk;           {reset for new file }
  Write('New Work File? ');
  Readln(SourceName);
  If SourceName <> '' then
    begin
      SourceName := Caps(SourceName);
      If Pos('.',SourceName) = 0 then SourceName := SourceName + '.ASM';
      If Exist(SourceName) then
        begin
          Write('Loading...');
          CurWin^.FileName := SourceName;
          EditReaTxtFil(SourceName);
          If NOT OK then
            begin
              Write('Source too large - Will assemble from Disk');
              EditWindowDeleteText;
            end
          Else
            SourceLoc := Memory;
          Writeln;
        end
      Else
        begin
          Writeln('New file');
          SourceLoc := Memory;
          Curwin^.FileName := SourceName;
        end
    end;

  Write('>');

End;  {ChangeWorkFile }

Procedure ChangeListLoc; {changes where output listing will go }

Begin {ChangeListLoc }

  Write('Send Output to [P]rinter, [S]creen, [D]isk file, [CR]-None ');
  Repeat Read(Kbd,ch) Until UpCase(ch) in ['P','S','D',#13 {CR} ];
  Writeln(UpCase(ch));
  Write('>');
  Case UpCase(ch) of
    'P' : ListLoc := Printer;
    'S' : ListLoc := Scrn;
    #13 : ListLoc := NoIO;
    'D' : Begin
            ListLoc := Disk;
            Write('List File name? [.LST] ');
            Readln(ListName);
            ListName := Caps(ListName);
            Write('>');
            if Length(ListName) = 0 then
              begin
                If SourceName <> '' then
                 ListName := Copy(SourceName,1,Pos('.',SourceName)-1) + '.LST'
                Else ListLoc := NoIO;
              end
            else
              if Pos('.',ListName) = 0 then ListName := ListName + '.LST';
          End;
  End; {Case ch }

End;  {ChangeListLoc }

Procedure Assemble; {starts the whole mess a goin' }

Begin {Assemble }

  If SourceName <> '' then
    begin
      {Initialize Variables }
       For i := 0 to MAXOBJ do Obj[i] := 0;
       For i := 0 to MAXSTK do ProcType[i] := 0;
       StkTop   := 0;
       Errs     := 0;
       Diag     := 0;
       CodeSize := 0;
       NumSym   := Predef;

      {Init Object file }
       ObjName := Copy(SourceName,1,Pos('.',SourceName)-1) + '.COM';
       Assign(ObjFile,ObjName);
       Rewrite(ObjFile);

      {Init List file, if any }
       Case ListLoc of
         Scrn,
         NoIO    : Assign(ListFile,'TRM:');
         Printer : Assign(ListFile,'LST:');
         Disk    : begin
                     Assign(ListFile,ListName);
                     Rewrite(ListFile);
                   end;
       End; {Case }

       FirstPass;
       PassTwo;
       FinalProc;
    end
  Else
    Writeln('No Source File Specified');

  Write('>');

End;  {Assemble }

Procedure Quit;

Begin {Quit }

  Quitting := true;
  if SourceLoc = Memory then
    begin
      if EditChangeFlag then
        begin
          Write('Save changes? [Y/N] ');
          Repeat Read(Kbd,ch) Until UpCase(ch) in ['Y','N'];
          Writeln(UpCase(ch));
          If UpCase(ch) = 'Y' then
            begin
              Write('Saving...');
              if EditFileWrite(SourceName) then;
            end;
        end;
      EditWindowDeleteText;
    end

End;  {Quit }

Procedure EditFile; { Calls the editor functions}

var
  r,c : byte;

Begin {EditFile }
  If (SourceName = '') OR (SourceLoc = Disk) then
    begin
      if SourceName = '' then Writeln('No Work file specified')
      else Writeln('Cannot edit ',SourceName);
      Write('>');
      EXIT;
    end;

  { Initialize screen array and other stuff }

  for r := 1 to Defnorows do
    for c := 1 to Defnocols do
      with Screen [r,c] do
        begin
          Ch := chr (0);            {Have the editor clean up the screen}
          Color := Txtcolor
        end;

  RunDown := false;
  EditWindowTopFile;
  EditUpdPhyScr;
  EditSystem;
  MainScreen;

End;  {EditFile }

Procedure SaveFile; {Calls the editor save function }

Begin {SaveFile }

  If (SourceName = '') OR (SourceLoc = Disk) then
    begin
      if SourceLoc = Disk then Writeln('File not in memory')
      else Writeln('No Work file specified');
      Write('>');
      EXIT;
    end;

  If Exist(SourceName) then
    begin
      Write('Overwrite existing file? [Y/N] ');
      Repeat Read(Kbd,ch) Until UpCase(ch) in ['Y','N'];
      If UpCase(ch) = 'N' then
        begin
          Writeln;
          Write('>');
          EXIT;
        end
    end;

  Write('Saving...');
  If EditFileWrite(SourceName) then;
  Writeln;
  Write('>');

End;  {SaveFile }

BEGIN

  TitleStart;
  SetUpTables;
  EditInitialize;

  MainScreen;

  While NOT Quitting Do
    begin
      Read(Kbd,ch);
      Case UpCase(ch) of
        'W' : ChangeWorkFile;
        'S' : SaveFile;
        'D' : ShowDirectory;
        'E' : EditFile;
        'A' : Assemble;
        'O' : ChangeListLoc;
        'Q' : Quit;
        'L' : ChangeDirectory;
        Else  MainScreen;
      End; {Case ch }
    end;

END.